home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / libguile / gscm.h < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-16  |  11.6 KB  |  362 lines
  1. /* classes: h_files */
  2.  
  3. #ifndef GSCMH
  4. #define GSCMH
  5.  
  6. /*    Copyright (C) 1994 Free Software Foundation, Inc.
  7.  
  8. This program is free software; you can redistribute it and/or modify
  9. it under the terms of the GNU General Public License as published by
  10. the Free Software Foundation; either version 2, or (at your option)
  11. any later version.
  12.  
  13. This program is distributed in the hope that it will be useful,
  14. but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. GNU General Public License for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with this software; see the file COPYING.  If not, write to
  20. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  21. /*  t. lord    Mon Jan 16 15:22:28 1995    */
  22.  
  23.  
  24. #ifdef STDC_HEADERS
  25. # include <stdlib.h>
  26. # ifdef AMIGA
  27. #  include <stddef.h>
  28. # endif /* def AMIGA */
  29. # define sizet size_t
  30. #else
  31. # ifdef _SIZE_T
  32. #  define sizet size_t
  33. # else
  34. #  define sizet unsigned int
  35. # endif /* def _SIZE_T */
  36. #endif /* def STDC_HEADERS */
  37.  
  38. #include "__scm.h"
  39. #include "error.h"
  40. #include "boolean.h"
  41. #include "numbers.h"
  42. #include "chars.h"
  43. #include "pairs.h"
  44. #include "smob.h"
  45. #include "symbols.h"
  46. #include "strings.h"
  47. #include "strop.h"
  48. #include "kw.h"
  49. #include "variable.h"
  50. #include "vectors.h"
  51. #include "record.h"
  52. #include "unif.h"
  53. #include "ramap.h"
  54. #include "struct.h"
  55. #include "procs.h"
  56. #include "gsubr.h"
  57. #include "ports.h"
  58. #include "vports.h"
  59. #include "fports.h"
  60. #include "strports.h"
  61. #include "eq.h"
  62. #include "dynwind.h"
  63. #include "continuations.h"
  64. #include "time.h"
  65. #include "hash.h"
  66. #include "files.h"
  67. #include "arbiters.h"
  68. #include "throw.h"
  69. #include "eval.h"
  70. #include "feature.h"
  71. #include "scmsigs.h"
  72. #include "simpos.h"
  73. #include "gc.h"
  74. #include "stackchk.h"
  75. #include "repl.h"
  76.  
  77. #ifndef P
  78. #ifdef __STDC__
  79. #define P(s) s
  80. #else
  81. #define P(s) ()
  82. #endif
  83. #endif
  84.  
  85. typedef int GSCM_top_level;
  86. typedef int GSCM_status;
  87.  
  88. #define GSCM_OK             0
  89. #define GSCM_QUIT             (GSCM_OK + 1)
  90. #define GSCM_RESTART             (GSCM_QUIT + 1)
  91. #define GSCM_ILLEGALLY_REENTERED     (GSCM_RESTART + 1)
  92. #define GSCM_OUT_OF_MEM         (GSCM_ILLEGALLY_REENTERED + 1)
  93. #define GSCM_ERROR_OPENING_FILE        (GSCM_OUT_OF_MEM + 1)
  94. #define GSCM_ERROR_OPENING_INIT_FILE    (GSCM_ERROR_OPENING_FILE + 1)
  95.  
  96. typedef int (*gscm_equal_fn) P((SCM a, SCM b));
  97. typedef int (*gscm_print_fn) P((SCM obj, SCM port, int writingp));
  98. typedef void (*gscm_die_fn) P((SCM obj));
  99.  
  100. struct gscm_type
  101. {
  102.   char * name;
  103.   gscm_equal_fn equal;
  104.   gscm_print_fn print;
  105.   gscm_die_fn die;
  106. };
  107.  
  108.  
  109. #define GSCM_DEFER_INTS            SCM_DEFER_INTS
  110. #define GSCM_ALLOW_INTS            SCM_ALLOW_INTS
  111.  
  112. #define GSCM_EOL            SCM_EOL
  113. #define GSCM_FALSE            SCM_BOOL_F
  114. #define GSCM_TRUE            SCM_BOOL_T
  115.  
  116.  
  117. #define gscm_cons         scm_cons
  118. #define gscm_list         scm_listify
  119. #define gscm_ilength        scm_ilength
  120. #define gscm_obj_length        scm_obj_length
  121. #define GSCM_EOL_MARKER     SCM_UNDEFINED
  122. #define GSCM_NOT_PASSED         SCM_UNDEFINED
  123. #define GSCM_UNSPECIFIED     SCM_UNSPECIFIED
  124.  
  125. #define gscm_set_car(OBJ, VAL) \
  126.    ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
  127.            ? (SCM_CAR(OBJ) = VAL) \
  128.            : scm_wta ((OBJ), (char *)SCM_ARG1, "set-car!"))
  129.  
  130. #define gscm_set_cdr(OBJ, VAL) \
  131.    ((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
  132.            ? (SCM_CDR(OBJ) = VAL) \
  133.            : scm_wta ((OBJ), (char *)SCM_ARG1, "set-cdr!"))
  134.  
  135.  
  136. #define SCAR(X)   ((SCM_NIMP(X) && SCM_CONSP(X)) \
  137.            ? SCM_CAR(X) \
  138.            : scm_wta ((X), (char *)SCM_ARG1, "car"))
  139.  
  140. #define SCDR(X)   ((SCM_NIMP(X) && SCM_CONSP(X)) \
  141.            ? SCM_CDR(X) \
  142.            : scm_wta ((X), (char *)SCM_ARG1, "cdr"))
  143.  
  144. #define gscm_car(OBJ)        SCAR (OBJ)
  145. #define gscm_cdr(OBJ)        SCDR (OBJ)
  146.  
  147. #define gscm_caar(OBJ)        SCAR (SCAR (OBJ))
  148. #define gscm_cdar(OBJ)        SCDR (SCAR (OBJ))
  149. #define gscm_cadr(OBJ)        SCAR (SCDR (OBJ))
  150. #define gscm_cddr(OBJ)        SCDR (SCDR (OBJ))
  151.  
  152. #define gscm_caaar(OBJ)        SCAR (SCAR (SCAR (OBJ)))
  153. #define gscm_cdaar(OBJ)        SCDR (SCAR (SCAR (OBJ)))
  154. #define gscm_cadar(OBJ)        SCAR (SCDR (SCAR (OBJ)))
  155. #define gscm_cddar(OBJ)        SCDR (SCDR (SCAR (OBJ)))
  156. #define gscm_caadr(OBJ)        SCAR (SCAR (SCDR (OBJ)))
  157. #define gscm_cdadr(OBJ)        SCDR (SCAR (SCDR (OBJ)))
  158. #define gscm_caddr(OBJ)        SCAR (SCDR (SCDR (OBJ)))
  159. #define gscm_cdddr(OBJ)        SCDR (SCDR (SCDR (OBJ)))
  160.  
  161. #define gscm_caaaar(OBJ)    SCAR (SCAR (SCAR (SCAR (OBJ))))
  162. #define gscm_cdaaar(OBJ)    SCDR (SCAR (SCAR (SCAR (OBJ))))
  163. #define gscm_cadaar(OBJ)    SCAR (SCDR (SCAR (SCAR (OBJ))))
  164. #define gscm_cddaar(OBJ)    SCDR (SCDR (SCAR (SCAR (OBJ))))
  165. #define gscm_caadar(OBJ)    SCAR (SCAR (SCDR (SCAR (OBJ))))
  166. #define gscm_cdadar(OBJ)    SCDR (SCAR (SCDR (SCAR (OBJ))))
  167. #define gscm_caddar(OBJ)    SCAR (SCDR (SCDR (SCAR (OBJ))))
  168. #define gscm_cdddar(OBJ)    SCDR (SCDR (SCDR (SCAR (OBJ))))
  169. #define gscm_caaadr(OBJ)    SCAR (SCAR (SCAR (SCDR (OBJ))))
  170. #define gscm_cdaadr(OBJ)    SCDR (SCAR (SCAR (SCDR (OBJ))))
  171. #define gscm_cadadr(OBJ)    SCAR (SCDR (SCAR (SCDR (OBJ))))
  172. #define gscm_cddadr(OBJ)    SCDR (SCDR (SCAR (SCDR (OBJ))))
  173. #define gscm_caaddr(OBJ)    SCAR (SCAR (SCDR (SCDR (OBJ))))
  174. #define gscm_cdaddr(OBJ)    SCDR (SCAR (SCDR (SCDR (OBJ))))
  175. #define gscm_cadddr(OBJ)    SCAR (SCDR (SCDR (SCDR (OBJ))))
  176. #define gscm_cddddr(OBJ)    SCDR (SCDR (SCDR (SCDR (OBJ))))
  177.  
  178. #define gscm_ulong         scm_ulong2num
  179. #define gscm_long         scm_long2num
  180. #define gscm_double(X)        scm_makdbl ((X), 0.0)
  181. #define gscm_char(C)        SCM_MAKICHR(C)
  182.  
  183. #define gscm_2_ulong(OBJ)    scm_num2ulong((OBJ), (char *)SCM_ARG1, "gscm_2_ulong")
  184. #define gscm_2_long(OBJ)    scm_num2long((OBJ), (char *)SCM_ARG1, "gscm_2_long")
  185. #define gscm_2_double(OBJ)    scm_num2dbl((OBJ), "gscm_2_double")
  186. extern int gscm_2_char P((SCM));
  187.  
  188. #define gscm_str(SRC, LEN)    scm_makfromstr (SRC, LEN, 0)
  189. #define gscm_str0        makfrom0str
  190. extern void gscm_2_str P((char ** str_out, int * len_out, SCM * obj_in));
  191.  
  192. #if 0
  193. This was a mistake.  These three gscm_ entry points should return
  194. boolean values of type SCM, not C integers.  The "is_eq" forms
  195. are the ones that return integers.
  196.  
  197. Here is the plan.  If your code was broken when this code was
  198. commented out, please change your code to use gscm_is_eq*.  Then,
  199. a future snapshot, i will add the gscm_eq* entry points back
  200. in, but with a different return type.
  201.  
  202. Sorry for any inconvenience.
  203.  
  204. -t
  205.  
  206.  
  207. #define gscm_eq(OBJ)        (SCM_BOOL_F != scm_eq (OBJ))
  208. #define gscm_eqv(OBJ)        (SCM_BOOL_F != scm_eqv (OBJ))
  209. #define gscm_equal(OBJ)        (SCM_BOOL_F != scm_equal (OBJ))
  210. #endif
  211.  
  212. #define gscm_is_eq(OBJ)        (SCM_BOOL_F != scm_eq (OBJ))
  213. #define gscm_is_eqv(OBJ)        (SCM_BOOL_F != scm_eqv (OBJ))
  214. #define gscm_is_equal(OBJ)        (SCM_BOOL_F != scm_equal (OBJ))
  215.  
  216. #define gscm_bool(CBOOL)    ((CBOOL) ? SCM_BOOL_T : SCM_BOOL_F)
  217. #define gscm_2_bool(BOOL)    (((BOOL) == SCM_BOOL_F) ? 0 : 1)
  218.  
  219. #define gscm_symbol(STR, LEN)      SCM_CAR(scm_intern (STR, LEN))
  220. #define gscm_tmp_symbol(STR, LEN) SCM_CAR(scm_intern_obarray (STR, LEN, SCM_BOOL_F))
  221.  
  222. #define gscm_vector(N, FILL)    scm_make_vector (SCM_MAKINUM(N), (FILL))
  223. #define gscm_vref(V, I)        scm_vector_ref ((V), SCM_MAKINUM(I))
  224. #define gscm_vset(V, I, VAL)    scm_vector_set ((V), SCM_MAKINUM(I), (VAL))
  225.  
  226. extern SCM gscm_make_subr P((SCM (*fn)(),
  227.                  int req, int opt, int varp, char * doc));
  228. extern SCM gscm_curry P((SCM procedure, SCM first_arg));
  229.  
  230.  
  231. #define gscm_catch(T, TH, H)        scm_catch ((T), (TH), (H))
  232. #define gscm_throw(T, V)        scm_throw_exception ((T), (V))
  233. #define gscm_dynamic_wind(E, T, L)    scm_dynwind ((E), (T), (L))
  234.  
  235. #define gscm_apply(PROC, ARGS)        scm_apply ((PROC), (ARGS), SCM_EOL)
  236.  
  237. extern void gscm_error P((char * message, SCM args));
  238. extern SCM gscm_alloc P((struct gscm_type *, int size));
  239. extern char * gscm_unwrap_obj P((struct gscm_type *, SCM * obj));
  240. extern struct gscm_type * gscm_get_type P((SCM * obj));
  241.  
  242. #define gscm_print_obj            scm_iprin1
  243. #define gscm_putc            scm_putc
  244. #define gscm_puts            scm_puts
  245. #define gscm_fwrite            scm_fwrite
  246. #define gscm_flush            scm_flush
  247. #define gscm_mkarray(SIZE)        scm_mkarray((SIZE), 1)
  248. #define gscm_define            scm_sysintern
  249.  
  250. extern char * gscm_last_attempted_init_file;
  251.  
  252.  
  253.  
  254.  
  255. #ifndef GSCM_MAGIC_SNARFER
  256. #define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR)  \
  257.     static char RANAME[]=STR;
  258. #else
  259. #define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR)  \
  260. %%% gscm_define_procedure (RANAME, CFN, REQ, OPT, VAR, "")
  261. #endif
  262.  
  263.  
  264.  
  265.  
  266.  
  267. #ifdef __STDC__
  268. extern long gscm_mk_objid (SCM obj);
  269. extern SCM gscm_id2obj (long n);
  270. extern void gscm_free_id (long n);
  271. extern void gscm_id_reassign (long n, SCM obj);
  272. extern SCM gscm_sys_id(SCM n);
  273. extern SCM gscm_sys_default_verbosity (void);
  274. extern void gscm_verbosity (int n);
  275. extern void gscm_with_verbosity (int n, void (*fn)P((void *)), void * data);
  276. extern void gscm_set_init_heap_size (int x);
  277. extern int gscm_init_heap_size (void);
  278. extern GSCM_status gscm_init_from_fn (char *initfile, int argc, char **argv, void (*init_fn) ());
  279. extern void gscm_take_stdin (void);
  280. extern void gscm_verbose (int n);
  281. extern GSCM_status gscm_create_top_level (GSCM_top_level * answer);
  282. extern GSCM_status gscm_destroy_top_level (GSCM_top_level it);
  283. extern GSCM_status gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str);
  284. extern void format_load_command (char * buf, char *file_name);
  285. extern GSCM_status gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name);
  286. extern GSCM_status gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str);
  287. extern GSCM_status gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name);
  288. extern char * gscm_error_msg (int n);
  289. extern void gscm_define_procedure (char * name, SCM (*fn)(), int req, int opt, int varp, char * doc);
  290. extern SCM gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc);
  291. extern SCM gscm_curry (SCM procedure, SCM first_arg);
  292. extern int gscm_2_char (SCM c);
  293. extern void gscm_2_str (char ** out, int * len_out, SCM * objp);
  294. extern void gscm_error (char * message, SCM args);
  295. extern SCM gscm_alloc (struct gscm_type * type, int size);
  296. extern char * gscm_unwrap_obj (struct gscm_type * type, SCM * objp);
  297. extern struct gscm_type * gscm_get_type (SCM * objp);
  298. extern SCM gscm_procedure_properties (SCM proc);
  299. extern SCM gscm_set_procedure_properties_x (SCM proc, SCM new);
  300. extern SCM gscm_procedure_assoc (SCM p, SCM k);
  301. extern SCM gscm_procedure_property (SCM p, SCM k);
  302. extern SCM gscm_set_procedure_property_x (SCM p, SCM k, SCM v);
  303. extern GSCM_status guile_ks (void);
  304. extern GSCM_status gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd);
  305. extern SCM gscm_malloc_2_uve (int type, int k, int size, char * data);
  306. extern int gscm_is_gscm_obj (SCM obj);
  307.  
  308. #else /* STDC */
  309. extern long gscm_mk_objid ();
  310. extern SCM gscm_id2obj ();
  311. extern void gscm_free_id ();
  312. extern void gscm_id_reassign ();
  313. extern SCM gscm_sys_id();
  314. extern SCM gscm_sys_default_verbosity ();
  315. extern void gscm_verbosity ();
  316. extern void gscm_with_verbosity ();
  317. extern void gscm_set_init_heap_size ();
  318. extern int gscm_init_heap_size ();
  319. extern GSCM_status gscm_init_from_fn ();
  320. extern void gscm_take_stdin ();
  321. extern void gscm_verbose ();
  322. extern GSCM_status gscm_create_top_level ();
  323. extern GSCM_status gscm_destroy_top_level ();
  324. extern GSCM_status gscm_seval_str ();
  325. extern void format_load_command ();
  326. extern GSCM_status gscm_seval_file ();
  327. extern GSCM_status gscm_eval_str ();
  328. extern GSCM_status gscm_eval_file ();
  329. extern char * gscm_error_msg ();
  330. extern void gscm_define_procedure ();
  331. extern SCM gscm_make_subr ();
  332. extern SCM gscm_curry ();
  333. extern int gscm_2_char ();
  334. extern void gscm_2_str ();
  335. extern void gscm_error ();
  336. extern SCM gscm_alloc ();
  337. extern char * gscm_unwrap_obj ();
  338. extern struct gscm_type * gscm_get_type ();
  339. extern SCM gscm_procedure_properties ();
  340. extern SCM gscm_set_procedure_properties_x ();
  341. extern SCM gscm_procedure_assoc ();
  342. extern SCM gscm_procedure_property ();
  343. extern SCM gscm_set_procedure_property_x ();
  344. extern GSCM_status guile_ks ();
  345. extern GSCM_status gscm_run_scm ();
  346. extern SCM gscm_malloc_2_uve ();
  347. extern int gscm_is_gscm_obj ();
  348.  
  349. #endif /* STDC */
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361. #endif  /* GSCMH */
  362.